home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fcube.for < prev    next >
Text File  |  1991-06-03  |  3KB  |  162 lines
  1.  
  2. c
  3. c a program to demonstrate  double buffering and what happens
  4. c when you hit a clipping plane. Specifying an extra argument
  5. c turns on the filling.
  6. c
  7.     program cube
  8.  
  9. $INCLUDE: 'fvogl.h'
  10. $INCLUDE: 'fvodevic.h'
  11.  
  12.     character ans*1
  13.     real    t, dt
  14.     integer nplane, r, dr
  15.     logical ifill, s
  16.  
  17.     print*,'Fill the polygons (Y/N)?'
  18.     read(*, '(a)') ans
  19.     ifill = ans .eq. 'y' .or. ans .eq. 'Y'
  20.                   
  21.     call polymo(PYM_LI)
  22.     if (ifill) call polymo(PYM_FI)
  23.  
  24.     call prefsi(300, 300)
  25.  
  26.     call winope('fcube', 5)
  27.  
  28.     call unqdev(INPUTC)
  29.     call qdevic(KEYBD)
  30.  
  31.     dr = 100
  32.     dt = 0.2
  33.  
  34.     nplane = getpla()
  35.  
  36.     call color(BLACK)
  37.     call clear
  38.  
  39.     call window(-1.5, 1.5, -1.5, 1.5, 9.0, -5.0)
  40.     call lookat(0.0, 0.0, 12.0, 0.0, 0.0, 0.0, 0)
  41.  
  42.     call backfa(.true.)
  43. c
  44. c Setup drawing into the backbuffer....
  45. c
  46.     call double
  47.     call gconfi
  48.  
  49.     t = 0.0
  50.  
  51.     r = 0
  52.  
  53.  10    continue
  54.         if (r .ge. 3600) r = 0
  55.         call color(BLACK)
  56.         call clear
  57.  
  58.         call pushma
  59.  
  60.         call transl(0.0, 0.0, t)
  61.         call rotate(r, 'y')
  62.         call rotate(r, 'z')
  63.         call rotate(r, 'x')
  64.         call color(WHITE)
  65.  
  66.         call drawcu(nplane)
  67.  
  68.         if (nplane .eq. 1 .and. ifill) then
  69.             call polymo(PYM_LI)
  70.             call color(BLACK)
  71.             call drawcu(nplane)
  72.         if (ifill) call polymo(PYM_FI)
  73.         endif
  74.  
  75.         call popmat
  76.  
  77.         t = t + dt
  78.         if (t .gt. 3.0 .or. t .lt. -18.0) dt = -dt
  79.  
  80.         call swapbu
  81.  
  82.         s = qtest()
  83.         if (s) then
  84.             call gexit
  85.             stop
  86.         endif
  87.  
  88.         r = r + dr
  89.  
  90.     goto 10
  91.  
  92.     end
  93.  
  94. c
  95. c this routine draws the cube, using colours if available
  96. c
  97.     subroutine drawcu(nplane)
  98.     integer nplane
  99.  
  100. $INCLUDE: 'fvogl.h'
  101.  
  102.     real carray(3, 8)
  103.     data carray/
  104.      +     -1.0,  -1.0,   1.0,
  105.      +      1.0,  -1.0,   1.0,
  106.      +      1.0,   1.0,   1.0,
  107.      +     -1.0,   1.0,   1.0,
  108.      +     -1.0,  -1.0,  -1.0,
  109.      +      1.0,  -1.0,  -1.0,
  110.      +      1.0,   1.0,  -1.0,
  111.      +     -1.0,   1.0,  -1.0/
  112.  
  113.     if (nplane.gt.1) call color(RED)
  114.  
  115.     call pmv(carray(1,1), carray(2,1), carray(3,1))
  116.     call pdr(carray(1,2), carray(2,2), carray(3,2))
  117.     call pdr(carray(1,3), carray(2,3), carray(3,3))
  118.     call pdr(carray(1,4), carray(2,4), carray(3,4))
  119.     call pclos
  120.     
  121.     if (nplane.gt.1) call color(GREEN)
  122.  
  123.     call pmv(carray(1,6), carray(2,6), carray(3,6))
  124.     call pdr(carray(1,5), carray(2,5), carray(3,5))
  125.     call pdr(carray(1,8), carray(2,8), carray(3,8))
  126.     call pdr(carray(1,7), carray(2,7), carray(3,7))
  127.     call pclos
  128.  
  129.     if (nplane.gt.1) call color(YELLOW)
  130.  
  131.     call pmv(carray(1,2), carray(2,2), carray(3,2))
  132.     call pdr(carray(1,6), carray(2,6), carray(3,6))
  133.     call pdr(carray(1,7), carray(2,7), carray(3,7))
  134.     call pdr(carray(1,3), carray(2,3), carray(3,3))
  135.     call pclos
  136.  
  137.     if (nplane.gt.1) call color(BLUE)
  138.  
  139.     call pmv(carray(1,1), carray(2,1), carray(3,1))
  140.     call pdr(carray(1,4), carray(2,4), carray(3,4))
  141.     call pdr(carray(1,8), carray(2,8), carray(3,8))
  142.     call pdr(carray(1,5), carray(2,5), carray(3,5))
  143.     call pclos
  144.  
  145.     if (nplane.gt.1) call color(MAGENT)
  146.  
  147.     call pmv(carray(1,3), carray(2,3), carray(3,3))
  148.     call pdr(carray(1,7), carray(2,7), carray(3,7))
  149.     call pdr(carray(1,8), carray(2,8), carray(3,8))
  150.     call pdr(carray(1,4), carray(2,4), carray(3,4))
  151.     call pclos
  152.     
  153.     if (nplane.gt.1) call color(CYAN)
  154.  
  155.     call pmv(carray(1,1), carray(2,1), carray(3,1))
  156.     call pdr(carray(1,5), carray(2,5), carray(3,5))
  157.     call pdr(carray(1,6), carray(2,6), carray(3,6))
  158.     call pdr(carray(1,2), carray(2,2), carray(3,2))
  159.     call pclos
  160.  
  161.     end
  162.